Loading the Expression Data
The expression data are taken from this study: https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE232211
Download (1) the RNA-seq normalized counts matrix and (2) the human
gene annotation table by running:
wget https://www.ncbi.nlm.nih.gov/geo/download/?type=rnaseq_counts&acc=GSE232211&format=file&file=GSE232211_norm_counts_TPM_GRCh38.p13_NCBI.tsv.gz -P data/FHC/
wget https://www.ncbi.nlm.nih.gov/geo/download/?format=file&type=rnaseq_counts&file=Human.GRCh38.p13.annot.tsv.gz -P data/FHC/
fhc.expression <- read.delim(paste0(DATA_DIR, "GSE232211_norm_counts_TPM_GRCh38.p13_NCBI.tsv"), as.is = TRUE, header = TRUE, row.names = 1)
fhc.expression <- rownames_to_column(fhc.expression, "gene_id")
fhc.expression
mapping_table <- read.delim(paste0(DATA_DIR, "Human.GRCh38.p13.annot.tsv"), as.is = TRUE, header = TRUE, row.names = 1)
mapping_table <- rownames_to_column(mapping_table, "gene_id")
mapping_table <- subset(mapping_table, EnsemblGeneID != "")
mapping_table
Since the gene set for the RCD-related regulators (taken from RCDdb)
uses Ensembl Gene IDs, we need to map the accessions.
fhc.expression.mapped <- right_join(fhc.expression, mapping_table, by = join_by(gene_id == gene_id)) %>% distinct(EnsemblGeneID, .keep_all = TRUE)
rownames(fhc.expression.mapped) <- fhc.expression.mapped$EnsemblGeneID
fhc.expression.mapped = fhc.expression.mapped[,!(names(fhc.expression.mapped) %in% colnames(mapping_table))]
fhc.expression.mapped <- rownames_to_column(fhc.expression.mapped, "gene_id")
fhc.expression.mapped
Exploratory Data Analysis
We load the gene sets from RCDdb: https://pubmed.ncbi.nlm.nih.gov/39257527/
RCDdb <- "data/RCDdb/"
Necroptosis
Load the gene set.
genes <- read.csv(paste0(RCDdb, "Necroptosis.csv"))
genes$gene_id <- cleanid(genes$gene_id)
genes <- distinct(genes, gene_id, .keep_all = TRUE)
genes <- subset(genes, gene_id != "")
genes
Get the TPM for the genes in the gene set.
tpm.df <- fhc.expression.mapped %>% dplyr::filter(gene_id %in% genes$gene_id)
tpm.df <- left_join(tpm.df, genes %>% dplyr::select(gene_id, gene), by = c("gene_id" = "gene_id"))
rownames(tpm.df) <- tpm.df$gene
tpm.df <- tpm.df %>% dplyr::select(c(1:4))
tpm.df <- subset(tpm.df, select = -c(gene_id) )
tpm.df <- tpm.df[ order(row.names(tpm.df)), ]
tpm.df
Plot the results.
tpm.matrix <- as.matrix(tpm.df)
heatmap.2(tpm.matrix, srtCol=360, cellnote = tpm.matrix, dendrogram="none", Colv=FALSE, Rowv=FALSE,
col=brewer.pal(n = 9, name = "BuPu")[5:9], trace="none", key = FALSE, lwid=c(0.1,4), lhei=c(0.1,4),
cexCol=1, cexRow=0.75, symm = TRUE)
Ferroptosis
Load the gene set.
genes <- read.csv(paste0(RCDdb, "Ferroptosis.csv"))
genes$gene_id <- cleanid(genes$gene_id)
genes <- distinct(genes, gene_id, .keep_all = TRUE)
genes <- subset(genes, gene_id != "")
genes
Get the TPM for the genes in the gene set.
tpm.df <- fhc.expression.mapped %>% dplyr::filter(gene_id %in% genes$gene_id)
tpm.df <- left_join(tpm.df, genes %>% dplyr::select(gene_id, gene), by = c("gene_id" = "gene_id"))
rownames(tpm.df) <- tpm.df$gene
tpm.df <- tpm.df %>% dplyr::select(c(1:4))
tpm.df <- subset(tpm.df, select = -c(gene_id) )
tpm.df <- tpm.df[ order(row.names(tpm.df)), ]
tpm.df
Plot the results.
tpm.matrix <- as.matrix(tpm.df)
heatmap.2(tpm.matrix, srtCol=360, cellnote = tpm.matrix, dendrogram="none", Colv=FALSE, Rowv=FALSE,
col=brewer.pal(n = 9, name = "BuPu")[5:9], trace="none", key = FALSE, lwid=c(0.1,4), lhei=c(0.1,4),
cexCol=1, cexRow=0.75, symm = TRUE)
Pyroptosis
Load the gene set.
genes <- read.csv(paste0(RCDdb, "Pyroptosis.csv"))
genes$gene_id <- cleanid(genes$gene_id)
genes <- distinct(genes, gene_id, .keep_all = TRUE)
genes <- subset(genes, gene_id != "")
genes
Get the TPM for the genes in the gene set.
tpm.df <- fhc.expression.mapped %>% dplyr::filter(gene_id %in% genes$gene_id)
tpm.df <- left_join(tpm.df, genes %>% dplyr::select(gene_id, gene), by = c("gene_id" = "gene_id"))
rownames(tpm.df) <- tpm.df$gene
tpm.df <- tpm.df %>% dplyr::select(c(1:4))
tpm.df <- subset(tpm.df, select = -c(gene_id) )
tpm.df <- tpm.df[ order(row.names(tpm.df)), ]
tpm.df
Plot the results.
tpm.matrix <- as.matrix(tpm.df)
heatmap.2(tpm.matrix, srtCol=360, cellnote = tpm.matrix, dendrogram="none", Colv=FALSE, Rowv=FALSE,
col=brewer.pal(n = 9, name = "BuPu")[5:9], trace="none", key = FALSE, lwid=c(0.1,4), lhei=c(0.1,4),
cexCol=1, cexRow=0.75, symm = TRUE)
LS0tDQp0aXRsZTogIkdlbmUgRXhwcmVzc2lvbiBBbmFseXNpcyINCnN1YnRpdGxlOiAiRmV0YWwgY29sb24gY2VsbCBsaW5lIEZIQyB8IE5lY3JvcHRvc2lzLCBGZXJyb3B0b3NpcyAmIFB5cm9wdG9zaXMiDQphdXRob3I6IA0KICAtIE1hcmsgRWR3YXJkIE0uIEdvbnphbGVzXltEZSBMYSBTYWxsZSBVbml2ZXJzaXR5LCBNYW5pbGEsIFBoaWxpcHBpbmVzLCBnb256YWxlcy5tYXJrZWR3YXJkQGdtYWlsLmNvbV0NCiAgLSBEci4gQW5pc2ggTS5TLiBTaHJlc3RoYV5bRGUgTGEgU2FsbGUgVW5pdmVyc2l0eSwgTWFuaWxhLCBQaGlsaXBwaW5lcywgYW5pc2guc2hyZXN0aGFAZGxzdS5lZHUucGhdDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIyBJLiBQcmVsaW1pbmFyaWVzDQoNCiMjIyBMb2FkaW5nIGxpYnJhcmllcw0KDQpgYGB7ciwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkoInRpZHl2ZXJzZSIpDQpsaWJyYXJ5KCJ0aWJibGUiKQ0KbGlicmFyeSgibXNpZ2RiciIpDQpsaWJyYXJ5KCJnZ3Bsb3QyIikNCmxpYnJhcnkoImVuc2VtYmxkYiIpDQpsaWJyYXJ5KCJwdXJyciIpDQpsaWJyYXJ5KCJtYWdyaXR0ciIpDQpsaWJyYXJ5KCJtYXRyaXhTdGF0cyIpDQpsaWJyYXJ5KCJkcGx5ciIpDQpsaWJyYXJ5KCJncmV4IikNCmxpYnJhcnkoImdwbG90cyIpDQpsaWJyYXJ5KCJSQ29sb3JCcmV3ZXIiKQ0KYGBgDQoNCiMjIyBDb25zdGFudHMNCmBgYHtyfQ0KREFUQV9ESVIgPC0gImRhdGEvRkhDLyINCmBgYA0KDQojIyBMb2FkaW5nIHRoZSBFeHByZXNzaW9uIERhdGENCg0KVGhlIGV4cHJlc3Npb24gZGF0YSBhcmUgdGFrZW4gZnJvbSB0aGlzIHN0dWR5OiBodHRwczovL3d3dy5uY2JpLm5sbS5uaWguZ292L2dlby9xdWVyeS9hY2MuY2dpP2FjYz1HU0UyMzIyMTENCg0KRG93bmxvYWQgKDEpIHRoZSBSTkEtc2VxIG5vcm1hbGl6ZWQgY291bnRzIG1hdHJpeCBhbmQgKDIpIHRoZSBodW1hbiBnZW5lIGFubm90YXRpb24gdGFibGUgYnkgcnVubmluZzoNCmBgYA0Kd2dldCBodHRwczovL3d3dy5uY2JpLm5sbS5uaWguZ292L2dlby9kb3dubG9hZC8/dHlwZT1ybmFzZXFfY291bnRzJmFjYz1HU0UyMzIyMTEmZm9ybWF0PWZpbGUmZmlsZT1HU0UyMzIyMTFfbm9ybV9jb3VudHNfVFBNX0dSQ2gzOC5wMTNfTkNCSS50c3YuZ3ogLVAgZGF0YS9GSEMvDQp3Z2V0IGh0dHBzOi8vd3d3Lm5jYmkubmxtLm5paC5nb3YvZ2VvL2Rvd25sb2FkLz9mb3JtYXQ9ZmlsZSZ0eXBlPXJuYXNlcV9jb3VudHMmZmlsZT1IdW1hbi5HUkNoMzgucDEzLmFubm90LnRzdi5neiAtUCBkYXRhL0ZIQy8NCmBgYA0KYGBge3J9DQpmaGMuZXhwcmVzc2lvbiA8LSByZWFkLmRlbGltKHBhc3RlMChEQVRBX0RJUiwgIkdTRTIzMjIxMV9ub3JtX2NvdW50c19UUE1fR1JDaDM4LnAxM19OQ0JJLnRzdiIpLCBhcy5pcyA9IFRSVUUsIGhlYWRlciA9IFRSVUUsIHJvdy5uYW1lcyA9IDEpDQpmaGMuZXhwcmVzc2lvbiA8LSByb3duYW1lc190b19jb2x1bW4oZmhjLmV4cHJlc3Npb24sICJnZW5lX2lkIikNCmZoYy5leHByZXNzaW9uDQpgYGANCmBgYHtyfQ0KbWFwcGluZ190YWJsZSA8LSByZWFkLmRlbGltKHBhc3RlMChEQVRBX0RJUiwgIkh1bWFuLkdSQ2gzOC5wMTMuYW5ub3QudHN2IiksIGFzLmlzID0gVFJVRSwgaGVhZGVyID0gVFJVRSwgcm93Lm5hbWVzID0gMSkNCm1hcHBpbmdfdGFibGUgPC0gcm93bmFtZXNfdG9fY29sdW1uKG1hcHBpbmdfdGFibGUsICJnZW5lX2lkIikNCm1hcHBpbmdfdGFibGUgPC0gc3Vic2V0KG1hcHBpbmdfdGFibGUsIEVuc2VtYmxHZW5lSUQgIT0gIiIpDQptYXBwaW5nX3RhYmxlDQpgYGANClNpbmNlIHRoZSBnZW5lIHNldCBmb3IgdGhlIFJDRC1yZWxhdGVkIHJlZ3VsYXRvcnMgKHRha2VuIGZyb20gUkNEZGIpIHVzZXMgRW5zZW1ibCBHZW5lIElEcywgd2UgbmVlZCB0byBtYXAgdGhlIGFjY2Vzc2lvbnMuDQoNCmBgYHtyfQ0KZmhjLmV4cHJlc3Npb24ubWFwcGVkIDwtICByaWdodF9qb2luKGZoYy5leHByZXNzaW9uLCBtYXBwaW5nX3RhYmxlLCBieSA9IGpvaW5fYnkoZ2VuZV9pZCA9PSBnZW5lX2lkKSkgJT4lIGRpc3RpbmN0KEVuc2VtYmxHZW5lSUQsIC5rZWVwX2FsbCA9IFRSVUUpDQpyb3duYW1lcyhmaGMuZXhwcmVzc2lvbi5tYXBwZWQpIDwtIGZoYy5leHByZXNzaW9uLm1hcHBlZCRFbnNlbWJsR2VuZUlEDQpmaGMuZXhwcmVzc2lvbi5tYXBwZWQgPSBmaGMuZXhwcmVzc2lvbi5tYXBwZWRbLCEobmFtZXMoZmhjLmV4cHJlc3Npb24ubWFwcGVkKSAlaW4lIGNvbG5hbWVzKG1hcHBpbmdfdGFibGUpKV0NCmZoYy5leHByZXNzaW9uLm1hcHBlZCA8LSByb3duYW1lc190b19jb2x1bW4oZmhjLmV4cHJlc3Npb24ubWFwcGVkLCAiZ2VuZV9pZCIpDQpmaGMuZXhwcmVzc2lvbi5tYXBwZWQNCmBgYA0KDQojIyBFeHBsb3JhdG9yeSBEYXRhIEFuYWx5c2lzDQoNCldlIGxvYWQgdGhlIGdlbmUgc2V0cyBmcm9tIFJDRGRiOiBodHRwczovL3B1Ym1lZC5uY2JpLm5sbS5uaWguZ292LzM5MjU3NTI3Lw0KDQpgYGB7cn0NClJDRGRiIDwtICJkYXRhL1JDRGRiLyINCmBgYA0KDQojIyMgTmVjcm9wdG9zaXMNCg0KTG9hZCB0aGUgZ2VuZSBzZXQuDQoNCmBgYHtyfQ0KZ2VuZXMgPC0gcmVhZC5jc3YocGFzdGUwKFJDRGRiLCAiTmVjcm9wdG9zaXMuY3N2IikpDQpnZW5lcyRnZW5lX2lkIDwtIGNsZWFuaWQoZ2VuZXMkZ2VuZV9pZCkNCmdlbmVzIDwtIGRpc3RpbmN0KGdlbmVzLCBnZW5lX2lkLCAua2VlcF9hbGwgPSBUUlVFKQ0KZ2VuZXMgPC0gc3Vic2V0KGdlbmVzLCBnZW5lX2lkICE9ICIiKQ0KZ2VuZXMNCmBgYA0KDQpHZXQgdGhlIFRQTSBmb3IgdGhlIGdlbmVzIGluIHRoZSBnZW5lIHNldC4NCg0KYGBge3J9DQp0cG0uZGYgPC0gZmhjLmV4cHJlc3Npb24ubWFwcGVkICU+JSBkcGx5cjo6ZmlsdGVyKGdlbmVfaWQgJWluJSBnZW5lcyRnZW5lX2lkKQ0KdHBtLmRmIDwtIGxlZnRfam9pbih0cG0uZGYsIGdlbmVzICU+JSBkcGx5cjo6c2VsZWN0KGdlbmVfaWQsIGdlbmUpLCBieSA9IGMoImdlbmVfaWQiID0gImdlbmVfaWQiKSkNCnJvd25hbWVzKHRwbS5kZikgPC0gdHBtLmRmJGdlbmUNCnRwbS5kZiA8LSB0cG0uZGYgJT4lIGRwbHlyOjpzZWxlY3QoYygxOjQpKQ0KdHBtLmRmIDwtIHN1YnNldCh0cG0uZGYsIHNlbGVjdCA9IC1jKGdlbmVfaWQpICkNCnRwbS5kZiA8LSB0cG0uZGZbIG9yZGVyKHJvdy5uYW1lcyh0cG0uZGYpKSwgXQ0KdHBtLmRmDQpgYGANCg0KUGxvdCB0aGUgcmVzdWx0cy4NCg0KYGBge3IsIGZpZy5oZWlnaHQ9MzAsIGZpZy53aWR0aD0xMH0NCnRwbS5tYXRyaXggPC0gYXMubWF0cml4KHRwbS5kZikNCmhlYXRtYXAuMih0cG0ubWF0cml4LCBzcnRDb2w9MzYwLCBjZWxsbm90ZSA9IHRwbS5tYXRyaXgsIGRlbmRyb2dyYW09Im5vbmUiLCBDb2x2PUZBTFNFLCBSb3d2PUZBTFNFLA0KICAgICAgICAgIGNvbD1icmV3ZXIucGFsKG4gPSA5LCBuYW1lID0gIkJ1UHUiKVs1OjldLCB0cmFjZT0ibm9uZSIsIGtleSA9IEZBTFNFLCBsd2lkPWMoMC4xLDQpLCBsaGVpPWMoMC4xLDQpLA0KICAgICAgICAgIGNleENvbD0xLCBjZXhSb3c9MC43NSwgc3ltbSA9IFRSVUUpDQpgYGANCiMjIyBGZXJyb3B0b3Npcw0KDQpMb2FkIHRoZSBnZW5lIHNldC4NCg0KYGBge3J9DQpnZW5lcyA8LSByZWFkLmNzdihwYXN0ZTAoUkNEZGIsICJGZXJyb3B0b3Npcy5jc3YiKSkNCmdlbmVzJGdlbmVfaWQgPC0gY2xlYW5pZChnZW5lcyRnZW5lX2lkKQ0KZ2VuZXMgPC0gZGlzdGluY3QoZ2VuZXMsIGdlbmVfaWQsIC5rZWVwX2FsbCA9IFRSVUUpDQpnZW5lcyA8LSBzdWJzZXQoZ2VuZXMsIGdlbmVfaWQgIT0gIiIpDQpnZW5lcw0KYGBgDQoNCkdldCB0aGUgVFBNIGZvciB0aGUgZ2VuZXMgaW4gdGhlIGdlbmUgc2V0Lg0KDQpgYGB7cn0NCnRwbS5kZiA8LSBmaGMuZXhwcmVzc2lvbi5tYXBwZWQgJT4lIGRwbHlyOjpmaWx0ZXIoZ2VuZV9pZCAlaW4lIGdlbmVzJGdlbmVfaWQpDQp0cG0uZGYgPC0gbGVmdF9qb2luKHRwbS5kZiwgZ2VuZXMgJT4lIGRwbHlyOjpzZWxlY3QoZ2VuZV9pZCwgZ2VuZSksIGJ5ID0gYygiZ2VuZV9pZCIgPSAiZ2VuZV9pZCIpKQ0Kcm93bmFtZXModHBtLmRmKSA8LSB0cG0uZGYkZ2VuZQ0KdHBtLmRmIDwtIHRwbS5kZiAlPiUgZHBseXI6OnNlbGVjdChjKDE6NCkpDQp0cG0uZGYgPC0gc3Vic2V0KHRwbS5kZiwgc2VsZWN0ID0gLWMoZ2VuZV9pZCkgKQ0KdHBtLmRmIDwtIHRwbS5kZlsgb3JkZXIocm93Lm5hbWVzKHRwbS5kZikpLCBdDQp0cG0uZGYNCmBgYA0KDQpQbG90IHRoZSByZXN1bHRzLg0KDQpgYGB7ciwgZmlnLmhlaWdodD0xNTAsIGZpZy53aWR0aD0xMH0NCnRwbS5tYXRyaXggPC0gYXMubWF0cml4KHRwbS5kZikNCmhlYXRtYXAuMih0cG0ubWF0cml4LCBzcnRDb2w9MzYwLCBjZWxsbm90ZSA9IHRwbS5tYXRyaXgsIGRlbmRyb2dyYW09Im5vbmUiLCBDb2x2PUZBTFNFLCBSb3d2PUZBTFNFLA0KICAgICAgICAgIGNvbD1icmV3ZXIucGFsKG4gPSA5LCBuYW1lID0gIkJ1UHUiKVs1OjldLCB0cmFjZT0ibm9uZSIsIGtleSA9IEZBTFNFLCBsd2lkPWMoMC4xLDQpLCBsaGVpPWMoMC4xLDQpLA0KICAgICAgICAgIGNleENvbD0xLCBjZXhSb3c9MC43NSwgc3ltbSA9IFRSVUUpDQpgYGANCg0KIyMjIFB5cm9wdG9zaXMNCg0KTG9hZCB0aGUgZ2VuZSBzZXQuDQoNCmBgYHtyfQ0KZ2VuZXMgPC0gcmVhZC5jc3YocGFzdGUwKFJDRGRiLCAiUHlyb3B0b3Npcy5jc3YiKSkNCmdlbmVzJGdlbmVfaWQgPC0gY2xlYW5pZChnZW5lcyRnZW5lX2lkKQ0KZ2VuZXMgPC0gZGlzdGluY3QoZ2VuZXMsIGdlbmVfaWQsIC5rZWVwX2FsbCA9IFRSVUUpDQpnZW5lcyA8LSBzdWJzZXQoZ2VuZXMsIGdlbmVfaWQgIT0gIiIpDQpnZW5lcw0KYGBgDQoNCkdldCB0aGUgVFBNIGZvciB0aGUgZ2VuZXMgaW4gdGhlIGdlbmUgc2V0Lg0KDQpgYGB7cn0NCnRwbS5kZiA8LSBmaGMuZXhwcmVzc2lvbi5tYXBwZWQgJT4lIGRwbHlyOjpmaWx0ZXIoZ2VuZV9pZCAlaW4lIGdlbmVzJGdlbmVfaWQpDQp0cG0uZGYgPC0gbGVmdF9qb2luKHRwbS5kZiwgZ2VuZXMgJT4lIGRwbHlyOjpzZWxlY3QoZ2VuZV9pZCwgZ2VuZSksIGJ5ID0gYygiZ2VuZV9pZCIgPSAiZ2VuZV9pZCIpKQ0Kcm93bmFtZXModHBtLmRmKSA8LSB0cG0uZGYkZ2VuZQ0KdHBtLmRmIDwtIHRwbS5kZiAlPiUgZHBseXI6OnNlbGVjdChjKDE6NCkpDQp0cG0uZGYgPC0gc3Vic2V0KHRwbS5kZiwgc2VsZWN0ID0gLWMoZ2VuZV9pZCkgKQ0KdHBtLmRmIDwtIHRwbS5kZlsgb3JkZXIocm93Lm5hbWVzKHRwbS5kZikpLCBdDQp0cG0uZGYNCmBgYA0KDQpQbG90IHRoZSByZXN1bHRzLg0KDQpgYGB7ciwgZmlnLmhlaWdodD0yMCwgZmlnLndpZHRoPTEwfQ0KdHBtLm1hdHJpeCA8LSBhcy5tYXRyaXgodHBtLmRmKQ0KaGVhdG1hcC4yKHRwbS5tYXRyaXgsIHNydENvbD0zNjAsIGNlbGxub3RlID0gdHBtLm1hdHJpeCwgZGVuZHJvZ3JhbT0ibm9uZSIsIENvbHY9RkFMU0UsIFJvd3Y9RkFMU0UsDQogICAgICAgICAgY29sPWJyZXdlci5wYWwobiA9IDksIG5hbWUgPSAiQnVQdSIpWzU6OV0sIHRyYWNlPSJub25lIiwga2V5ID0gRkFMU0UsIGx3aWQ9YygwLjEsNCksIGxoZWk9YygwLjEsNCksDQogICAgICAgICAgY2V4Q29sPTEsIGNleFJvdz0wLjc1LCBzeW1tID0gVFJVRSkNCmBgYA==